home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / MIPS.prim.s < prev    next >
Encoding:
Text File  |  1993-02-09  |  18.8 KB  |  625 lines
  1. /* MIPS.prim.s
  2.  *
  3.  * COPYRIGHT (c) 1990 by AT&T Bell Laboratories.
  4. */
  5.  
  6. #include "mask.h"
  7. #include "tags.h"
  8. #include "request.h"
  9. #include "fpregs.h"
  10.  
  11. /*
  12.  * The MIPS registers are used as follows; the names in parentheses are the
  13.  * MLState field names (see ml_state.h):
  14.  */
  15.  
  16. #define          zero 0
  17. /* assembler-temp  1                               */
  18. #define     stdarg 2     /*      standard arg  (ml_arg)               */
  19. #define    stdcont 3     /*      standard continuation (ml_cont)       */
  20. #define    stdclos 4     /*      standard closure (ml_closure)             */
  21. #define    stdlink 5    /*     ptr to just-entered std function (ml_link) */
  22. #define   miscreg0 6    /*  miscellaneous registers, 0..12 (ml_roots[]) */
  23. #define   miscreg1 7
  24. #define   miscreg2 8
  25. #define   miscreg3 9
  26. #define  miscreg4 10
  27. #define  miscreg5 11
  28. #define  miscreg6 12
  29. #define  miscreg7 13
  30. #define  miscreg8 14
  31. #define  miscreg9 15
  32. #define miscreg10 16
  33. #define miscreg11 17
  34. #define miscreg12 18
  35. #define     limit 19     /*      end of heap - 4096  (ml_limitptr)         */
  36. #define    varptr 20     /*      per-thread var pointer (ml_varptr) */
  37. #define exhausted 21     /*      arith temp; also, heap-limit comparison flag */
  38. #define  storeptr 22     /*       store pointer  (ml_storeptr)         */
  39. #define  allocptr 23     /*     freespace pointer  (ml_allocptr) */
  40. #define   basereg 24     /*       pointer to base of code object+32764 (ml_roots[]) */
  41. #define    ptrtmp 25     /*       internal temporary */
  42. /*                26        reserved for operating system     */
  43. /*                27        reserved for operating system     */
  44. /*  globalptr     28        reserved for C and assembler */
  45. /*  stackptr      29          stack pointer             */
  46. #define   exncont 30     /*       exception handler (ml_exncont) */
  47. #define    gclink 31     /*     resumption point for restoreregs (ml_pc) */
  48.  
  49. #define atmp1 miscreg9
  50. #define atmp2 miscreg10
  51. #define atmp3 miscreg11
  52. #define atmp4 miscreg12
  53.  
  54. #define allocptr_offset      0    /* offsets in MLState */
  55. #define limit_offset         4
  56. #define storeptr_offset         8
  57. #define stdarg_offset        12
  58. #define stdcont_offset        16
  59. #define stdclos_offset        20
  60. #define exncont_offset        24
  61. #define gclink_offset        28
  62. #define    miscreg_offset(i)    36+4*(i)
  63. #define stdlink_offset        32
  64. #define varptr_offset        88
  65. #define basereg_offset        92
  66.  
  67. #define inML                    96
  68. #define request                100
  69. #define handlerPending         104
  70. #define inSigHandler           108
  71. #define maskSignals            112
  72. #define NumPendingSigs         116
  73. #define ioWaitFlag             120
  74. #define GCpending              124
  75. #define mask_               144
  76.  
  77. #define ML_CODE_HDR(name)                    \
  78.         .globl name;                    \
  79.         .align  2;    /* actually 4-byte alignment */        \
  80.         .word   TAG_backptr;                \
  81.     name:
  82.  
  83. #if (CALLEESAVE > 0)
  84. #define CONTINUE                        \
  85.         slt        $exhausted,$allocptr,$limit;    \
  86.             j        $stdcont;
  87. #else
  88. #define CONTINUE                        \
  89.         lw        $stdlink,0($stdcont);            \
  90.         slt        $exhausted,$allocptr,$limit;    \
  91.         j        $stdlink
  92. #endif
  93.  
  94. #define CHECKLIMIT(mask)                    \
  95.         bnez    $exhausted,3f;            \
  96.         lw        $exhausted,4($sp);        \
  97.         li        $ptrtmp,mask;            \
  98.         move    $gclink,$stdlink;                \
  99.         j        $exhausted;            \
  100.      3:
  101.  
  102.     .text
  103.  
  104.     .globl    saveregs
  105.     .globl    handle_c
  106.     .globl    return_c
  107.     .globl    restoreregs
  108.     .globl    savefpregs
  109.     .globl    restorefpregs
  110.  
  111.  
  112. #define regspace    40
  113. #define argbuild    16
  114. #define framesize    (regspace+argbuild) /* must be multiple of 8 */
  115. #define frameoffset    (0)
  116. #define MLSTATE_OFFSET  (0)
  117. #define STARTGC_OFFSET (4)
  118.  
  119.  
  120. /* sig_return : ('a cont * 'a) -> 'b
  121.  */
  122. ML_CODE_HDR(sigh_return_a)
  123.     li    $ptrtmp,contmask
  124.     li    $atmp1,REQ_SIG_RETURN
  125.     b    set_request
  126.  
  127. /* sigh_resume:
  128.  * Resume execution at the point at which a handler trap occurred.  
  129.  */
  130.     .globl    sigh_resume
  131. sigh_resume:
  132.     li    $ptrtmp,callcc_mask
  133.     li    $atmp1,REQ_SIG_RESUME
  134.     b    set_request
  135.  
  136. ML_CODE_HDR(handle_a) /* exception handler for ML functions called from C */
  137.     li    $ptrtmp,exnmask
  138.     li    $atmp1,REQ_EXN
  139.     b    set_request
  140.  
  141. ML_CODE_HDR(return_a) /* continuation for ML functions called from C */
  142.     li    $ptrtmp,contmask
  143.     li    $atmp1,REQ_RETURN
  144.     b    set_request
  145.  
  146.     .globl  request_fault
  147. request_fault:
  148.     li    $ptrtmp,exnmask
  149.     li    $atmp1,REQ_FAULT
  150.     b    set_request
  151.     
  152. ML_CODE_HDR(callc_a)
  153.     CHECKLIMIT(closmask)
  154.     li    $ptrtmp,closmask
  155.     li    $atmp1,REQ_CALLC
  156.     /* fall through */
  157.  
  158. set_request:
  159.     move    $exhausted,$ptrtmp    /* save the register mask */
  160.     lw    $ptrtmp,MLSTATE_OFFSET($sp)    /* save the minimal ML state */
  161.     sw    $exhausted,mask_($ptrtmp)
  162.     sw    $atmp1,request($ptrtmp)
  163.     sw    $zero,inML($ptrtmp)    /* note that we have left ML */
  164.     sw    $allocptr,allocptr_offset($ptrtmp)
  165.     sw    $storeptr,storeptr_offset($ptrtmp)
  166.     sw    $stdarg,stdarg_offset($ptrtmp)
  167.     sw    $stdcont,stdcont_offset($ptrtmp)
  168.     sw    $stdclos,stdclos_offset($ptrtmp)
  169.     sw    $exncont,exncont_offset($ptrtmp)
  170. #if CALLEESAVE > 0
  171.     sw    $miscreg0,miscreg_offset(0)($ptrtmp)
  172. #endif
  173. #if CALLEESAVE > 1
  174.     sw    $miscreg1,miscreg_offset(1)($ptrtmp)
  175. #endif
  176. #if CALLEESAVE > 2
  177.     sw    $miscreg2,miscreg_offset(2)($ptrtmp)
  178. #endif
  179. #if CALLEESAVE > 3
  180.     sw    $miscreg3,miscreg_offset(3)($ptrtmp)
  181. #endif
  182. #if CALLEESAVE > 4
  183.     sw    $miscreg4,miscreg_offset(4)($ptrtmp)
  184. #endif
  185. #if CALLEESAVE > 5
  186.     sw    $miscreg5,miscreg_offset(5)($ptrtmp)
  187. #endif
  188. #if CALLEESAVE > 6
  189.     sw    $miscreg6,miscreg_offset(6)($ptrtmp)
  190. #endif
  191. #if CALLEESAVE > 7
  192.     sw    $miscreg7,miscreg_offset(7)($ptrtmp)
  193. #endif
  194. #if CALLEESAVE > 8
  195.     sw    $miscreg8,miscreg_offset(8)($ptrtmp)
  196. #endif
  197.     sw    $varptr,varptr_offset($ptrtmp)
  198. restore_c_regs:
  199.     lw    $31,argbuild+36($sp)    /* restore the C registers */
  200.     lw    $30,argbuild+32($sp)
  201.         lw      $23,argbuild+28($sp)
  202.         lw      $22,argbuild+24($sp)
  203.         lw      $21,argbuild+20($sp)
  204.         lw      $20,argbuild+16($sp)
  205.         lw      $19,argbuild+12($sp)
  206.         lw      $18,argbuild+8($sp)
  207.         lw      $17,argbuild+4($sp)
  208.         lw      $16,argbuild($sp)
  209.     addu    $sp,framesize        /* discard the stack frame */
  210.     j    $31            /* return to run_ml() */
  211.  
  212. startgcptr: .word saveregs
  213.     .globl    saveregs
  214.     .ent    saveregs
  215. saveregs:
  216.     move    $exhausted,$ptrtmp    /* save the register mask */
  217.     lw    $ptrtmp,MLSTATE_OFFSET($sp)    /* save the ML state */
  218.     sw    $exhausted,mask_($ptrtmp)
  219.     bnez    $limit,1f
  220.     li      $limit,REQ_SIGNAL
  221.     sw    $limit,request($ptrtmp)
  222. 1:    
  223.     sw    $zero,inML($ptrtmp)        /* note that we have left ML */
  224.     sub     $basereg, 32764            /* adjust baseReg */
  225.     sw    $allocptr,allocptr_offset($ptrtmp)
  226.     sw    $storeptr,storeptr_offset($ptrtmp)
  227.     sw    $stdarg,stdarg_offset($ptrtmp)
  228.     sw    $stdcont,stdcont_offset($ptrtmp)
  229.     sw    $stdclos,stdclos_offset($ptrtmp)
  230.     sw    $gclink,gclink_offset($ptrtmp)
  231.     sw    $exncont,exncont_offset($ptrtmp)
  232.     sw    $miscreg0,miscreg_offset(0)($ptrtmp)    /* save misc. roots */
  233.     sw    $miscreg1,miscreg_offset(1)($ptrtmp)
  234.     sw    $miscreg2,miscreg_offset(2)($ptrtmp)
  235.     sw    $miscreg3,miscreg_offset(3)($ptrtmp)
  236.     sw    $miscreg4,miscreg_offset(4)($ptrtmp)
  237.     sw    $miscreg5,miscreg_offset(5)($ptrtmp)
  238.     sw    $miscreg6,miscreg_offset(6)($ptrtmp)
  239.     sw    $miscreg7,miscreg_offset(7)($ptrtmp)
  240.     sw    $miscreg8,miscreg_offset(8)($ptrtmp)
  241.     sw    $miscreg9,miscreg_offset(9)($ptrtmp)
  242.     sw    $miscreg10,miscreg_offset(10)($ptrtmp)
  243.     sw    $miscreg11,miscreg_offset(11)($ptrtmp)
  244.     sw    $miscreg12,miscreg_offset(12)($ptrtmp)
  245.     sw    $stdlink,stdlink_offset($ptrtmp)
  246.     sw    $basereg,basereg_offset($ptrtmp)        /* base reg */
  247.     sw    $varptr,varptr_offset($ptrtmp)
  248.     b    restore_c_regs
  249.  
  250.     .end    saveregs
  251.  
  252.     .ent    restoreregs
  253. restoreregs:
  254.     subu    $sp,framesize        /* allocate a stack frame */
  255.                     /* save the C registers */
  256. .frame $sp,framesize,$zero
  257. .mask 0xc0ff0000,frameoffset
  258.     lw    $5,startgcptr
  259.     sw    $4,MLSTATE_OFFSET($sp)    /* save MLState ptr for return to C */
  260.     sw    $5,STARTGC_OFFSET($sp) /* so ML can find saveregs! */
  261.     sw    $31,argbuild+36($sp)
  262.     sw    $30,argbuild+32($sp)
  263.         sw      $23,argbuild+28($sp)
  264.         sw      $22,argbuild+24($sp)
  265.         sw      $21,argbuild+20($sp)
  266.         sw      $20,argbuild+16($sp)
  267.         sw      $19,argbuild+12($sp)
  268.         sw      $18,argbuild+8($sp)
  269.         sw      $17,argbuild+4($sp)
  270.         sw      $16,argbuild($sp)
  271.                     
  272.     move    $ptrtmp,$4             /* MLState ptr should be in */
  273.                                        /* C standard arg thanks to run_ml */
  274.     lw    $allocptr,allocptr_offset($ptrtmp)
  275.     lw    $limit,limit_offset($ptrtmp)
  276.     lw    $storeptr,storeptr_offset($ptrtmp)
  277.  
  278.     li    $atmp1,1
  279. .set    noreorder            /* the order here is important */
  280.     sw    $atmp1,inML($ptrtmp)    /* note that we are entering ML code */
  281.     lw    $atmp1,GCpending($ptrtmp)    /* check for gc sync */
  282.     nop
  283.     beqz    $atmp1,6f
  284.     nop
  285.     li    $limit,0        /* adjust the limit register */
  286. 6:
  287.     lw    $atmp1,NumPendingSigs($ptrtmp)    /* check for pending signals */
  288.     nop                /* (load delay slot) */
  289.     bnez    $atmp1,1f
  290.     nop                /* (branch delay slot) */
  291. 8:    lw    $stdarg,stdarg_offset($ptrtmp)
  292.     lw    $stdcont,stdcont_offset($ptrtmp)
  293.     lw    $stdclos,stdclos_offset($ptrtmp)
  294.     lw    $exncont,exncont_offset($ptrtmp)
  295.     lw    $miscreg0,miscreg_offset(0)($ptrtmp)
  296.     lw    $miscreg1,miscreg_offset(1)($ptrtmp)
  297.     lw    $miscreg2,miscreg_offset(2)($ptrtmp)
  298.     lw    $miscreg3,miscreg_offset(3)($ptrtmp)
  299.     lw    $miscreg4,miscreg_offset(4)($ptrtmp)
  300.     lw    $miscreg5,miscreg_offset(5)($ptrtmp)
  301.     lw    $miscreg6,miscreg_offset(6)($ptrtmp)
  302.     lw    $miscreg7,miscreg_offset(7)($ptrtmp)
  303.     lw    $miscreg8,miscreg_offset(8)($ptrtmp)
  304.     lw    $miscreg9,miscreg_offset(9)($ptrtmp)
  305.     lw    $miscreg10,miscreg_offset(10)($ptrtmp)
  306.     lw    $miscreg11,miscreg_offset(11)($ptrtmp)
  307.     lw    $miscreg12,miscreg_offset(12)($ptrtmp)
  308.     lw    $stdlink,stdlink_offset($ptrtmp)
  309.     lw    $varptr,varptr_offset($ptrtmp)
  310.     lw     $basereg,basereg_offset($ptrtmp)
  311.     lw    $gclink,gclink_offset($ptrtmp)
  312.     add     $basereg,32764        /* adjust baseReg */
  313.     slt    $exhausted,$allocptr,$limit
  314.     .end    restoreregs
  315.     .globl    go
  316.     .ent    go
  317. go:    j    $gclink            /* jump to ML code */
  318.     nop
  319.     .end    go
  320. 1:                      /* there are pending signals, */
  321.     lw    $atmp1,maskSignals($ptrtmp)    /* are signal masked? */
  322.     nop                /* (load delay slot) */
  323.     bnez    $atmp1,8b
  324.     nop                /* (branch delay slot) */
  325.     lw    $atmp1,inSigHandler($ptrtmp)    /* check for a pending handler */
  326.     nop                /* (load delay slot) */
  327.     bnez    $atmp1,8b              
  328.         li    $atmp1,1        /* (branch delay slot) */
  329.     sw    $atmp1,handlerPending($ptrtmp)    /* note the pending handler */
  330.     li    $limit,0        /* trap on the next limit check. */
  331.     beqz     $zero,8b
  332.     nop
  333. .set    reorder
  334.  
  335.     .text
  336.     .ent savefpregs            /* Only called from signal.c */
  337.     .set reorder
  338. savefpregs:
  339.     li      $15,MAKE_DESC(NSAVED_FPREGS*8, TAG_string)
  340.     lw     $14,allocptr_offset($4)
  341.         sw      $15,0($14)          /* string tag */
  342.     swc1    $f20,4($14)        /* fpr20 */
  343.     swc1    $f21,8($14)
  344.     swc1    $f22,12($14)        /* fpr22 */
  345.     swc1    $f23,16($14)
  346.     swc1    $f24,20($14)        /* fpr24 */
  347.     swc1    $f25,24($14)
  348.     swc1    $f26,28($14)        /* fpr26 */
  349.     swc1    $f27,32($14)
  350.     swc1    $f28,36($14)        /* fpr28 */
  351.     swc1    $f29,40($14)
  352.     j     $31            /* return */
  353.     .end    savefpregs
  354.  
  355.     .ent    restorefpregs        /* Only called from signal.c */
  356.     .set     reorder
  357. restorefpregs:                /* floats address passed as parm */
  358.     lwc1    $f20,    0($4)        /* retrieve float registers */
  359.     lwc1    $f21,    4($4)
  360.     lwc1    $f22,    8($4)
  361.     lwc1    $f23,    12($4)
  362.     lwc1    $f24,    16($4)
  363.     lwc1    $f25,    20($4)
  364.     lwc1    $f26,    24($4)
  365.     lwc1    $f27,    28($4)
  366.     lwc1    $f28,    32($4)
  367.     lwc1    $f29,    36($4)
  368.     j    $31
  369.     .end     restorefpregs
  370.  
  371. /* try_lock : spin_lock -> bool
  372.  * low-level primitive for mutual-exclusion among processors -- note,
  373.  * the "atomicity" guaranteed by try_lock is only between processors and
  374.  * not between signals.  
  375.  */
  376. ML_CODE_HDR(try_lock_a)
  377. #if (MAX_PROCS > 1)
  378. #ifdef SGI
  379. .set noreorder
  380.     lw    $stdarg,0($stdarg)
  381.     nop
  382.     sll    $stdarg,1
  383.     xori    $stdarg,3
  384.     andi    $stdarg,3
  385. .set reorder
  386.     CONTINUE
  387. #endif SGI
  388. #else (MAX_PROCS == 1)
  389.     lw    $atmp1,0($stdarg)
  390.     li    $atmp2,1        /* ML_false */
  391.     sw    $atmp2,0($stdarg)
  392.     move    $stdarg,$atmp1
  393.     CONTINUE
  394. #endif (MAX_PROCS > 1)
  395.  
  396. ML_CODE_HDR(unlock_a)
  397. #if (MAX_PROCS > 1)
  398. #ifdef SGI
  399.     sw    $zero,0($stdarg)
  400.     li    $stdarg,1
  401.     CONTINUE
  402. #endif SGI
  403. #else (MAX_PROCS == 1)
  404.     li    $atmp1,3        /* ML_true */
  405.     sw    $atmp1,0($stdarg)
  406.     li    $stdarg,1        /* just return unit */
  407.     CONTINUE
  408. #endif (MAX_PROCS > 1)
  409.  
  410. /* array : (int * 'a) -> 'a array
  411.  * Allocate and initialize a new array.     This can cause GC.
  412.  */
  413. ML_CODE_HDR(array_a)
  414.     lw    $atmp1,0($stdarg)    /* tagged length in $atmp1 */
  415.     lw    $atmp4,4($stdarg)        /* get initial value in $atmp4 */
  416.     sra    $atmp1,1        /* untagged length */
  417.     sll    $atmp2,$atmp1,width_tags /* build descriptor in $atmp2 */
  418.     ori    $atmp2,TAG_array
  419.     sll    $atmp1,2        /* get length in bytes into $atmp1 */
  420.     sub    $atmp3,$limit,$allocptr    /* subtract allocptr */
  421.     sub    $atmp3,$atmp3,$atmp1    /* subtract requested bytes */
  422.     move    $gclink,$stdlink
  423.     li    $ptrtmp,closmask
  424.     blez    $atmp3,saveregs        /* do we have enough? */
  425.     sw    $atmp2,0($allocptr)    /* store the descriptor */
  426.     add    $allocptr,4        /* points to new object */
  427.     add    $atmp3,$atmp1,$allocptr    /* beyond last word of new array */
  428.     move    $stdarg,$allocptr    /* put ptr in return register */
  429.                     /* (return val = arg of continuation) */
  430. 2:                    /* loop */
  431.     sw    $atmp4,0($allocptr)      /* store the value */
  432.         addi    $allocptr,4          /* on to the next word */
  433.     bne    $allocptr,$atmp3,2b      /* if not off the end, repeat */
  434.                     /* end loop */
  435.         CONTINUE
  436.  
  437. /* create_b : int -> bytearray
  438.  * create_r : int -> realarray
  439.  * create_s : int -> string
  440.  * Create bytearray or string of given length.    This can cause GC.
  441.  */
  442. ML_CODE_HDR(create_r_a)
  443.     sra    $atmp1,$stdarg,1    /* $atmp1 = length */
  444.     sll    $atmp1,3
  445.     addi    $atmp1,4        /* length in bytes (including desc) */
  446.  
  447.     sub    $atmp3,$limit,$allocptr    /* subtract allocptr */
  448.     sub    $atmp3,$atmp3,$atmp1    /* subtract requested bytes */
  449.     move    $gclink,$stdlink
  450.     li    $ptrtmp,closmask
  451.     blez    $atmp3,saveregs        /* do we have enough? */
  452.     sra    $atmp2,$stdarg,1    /* build descriptor in atmp2 */
  453.     sll    $atmp2,width_tags
  454.     ori    $atmp2,TAG_realdarray
  455.     sw    $atmp2,0($allocptr)    /* store descriptor */
  456.     addi    $stdarg,$allocptr,4    /* pointer to new string */
  457.     add    $allocptr,$atmp1        /* advance allocptr */
  458.     CONTINUE
  459.  
  460. ML_CODE_HDR(create_b_a)
  461.     sra    $atmp1,$stdarg,1        /* $atmp1 = length */
  462.     addi    $atmp1,$atmp1,7
  463.     sra    $atmp1,2            /* length in words (including desc) */
  464.     sll    $atmp1,2             /* length in bytes (including desc) */
  465.  
  466.     sub    $atmp3,$limit,$allocptr    /* subtract allocptr */
  467.     sub    $atmp3,$atmp3,$atmp1    /* subtract requested bytes */
  468.     move    $gclink,$stdlink
  469.     li    $ptrtmp,closmask
  470.     blez    $atmp3,saveregs        /* do we have enough? */
  471.     sra    $atmp2,$stdarg,1    /* build descriptor in atmp2 */
  472.     sll    $atmp2,width_tags
  473.     ori    $atmp2,TAG_bytearray
  474.     sw    $atmp2,0($allocptr)    /* store descriptor */
  475.     addi    $stdarg,$allocptr,4    /* pointer to new string */
  476.     add    $allocptr,$atmp1        /* advance allocptr */
  477.     CONTINUE
  478.  
  479. ML_CODE_HDR(create_s_a)
  480.     sra    $atmp1,$stdarg,1        /* $atmp1 = length */
  481.     addi    $atmp1,$atmp1,7
  482.     sra    $atmp1,2            /* length in words (including desc) */
  483.     sll    $atmp1,2             /* length in bytes (including desc) */
  484.  
  485.     sub    $atmp3,$limit,$allocptr    /* subtract allocptr */
  486.     sub    $atmp3,$atmp3,$atmp1    /* subtract requested bytes */
  487.     move    $gclink,$stdlink
  488.     li    $ptrtmp,closmask
  489.     blez    $atmp3,saveregs        /* do we have enough? */
  490.     sra    $atmp2,$stdarg,1    /* build descriptor in atmp2 */
  491.     sll    $atmp2,width_tags
  492.     ori    $atmp2,TAG_string
  493.     sw    $atmp2,0($allocptr)    /* store descriptor */
  494.     addi    $stdarg,$allocptr,4    /* pointer to new string */
  495.     add    $allocptr,$atmp1        /* advance allocptr */
  496.     CONTINUE
  497.  
  498. /* create_v_a : int * 'a list -> 'a vector
  499.  *     creates a vector with elements taken from a list.
  500.  *    n.b. The frontend ensures that list cannot be nil.
  501.  */
  502. ML_CODE_HDR(create_v_a)
  503. #define ML_NIL         1
  504. #define ML_LIST_HD(p)    0(p)
  505. #define ML_LIST_TL(p)     4(p)
  506.     lw    $atmp1,0($stdarg)    /* atmp1 := tagged length */
  507.     sra    $atmp1,1        /* untagged length */
  508.     sll    $atmp2,$atmp1,width_tags/* build descriptor in $atmp2 */
  509.     ori    $atmp2,TAG_record    /* tag field */
  510.     sll    $atmp1,2        /* get length in bytes into $atmp1 */
  511.     sub    $atmp3,$limit,$allocptr    /* subtract allocptr */
  512.     sub    $atmp3,$atmp3,$atmp1    /* subtract requested bytes */
  513.     move    $gclink,$stdlink
  514.     li    $ptrtmp,closmask
  515.     blez    $atmp3,saveregs        /* do we have enough? */
  516.     sw    $atmp2,0($allocptr)    /* store the descriptor */
  517.     addi    $allocptr,4        /* points to new object */
  518.         lw      $atmp2, 4($stdarg)      /* atmp2 := list */
  519.     move    $stdarg,$allocptr    /* return val = arg of continuation */
  520.         li      $atmp3, ML_NIL          /* atmp3 := NIL */
  521. 3:                    /* loop */
  522.         lw      $atmp4, ML_LIST_HD($atmp2) /* atmp4 := data */
  523.         sw      $atmp4, 0($allocptr)     /* update vector */
  524.         lw      $atmp2, ML_LIST_TL($atmp2)
  525.         addi    $allocptr, 4            /* next index */
  526.         bne     $atmp2, $atmp3, 3b      /* reached end? */
  527.         CONTINUE
  528.  
  529. #ifdef MIPSEL
  530. #define BIGPART 4
  531. #else
  532. #define BIGPART 0
  533. #endif
  534. #define LITTLEPART (4-BIGPART)
  535.  
  536. /* Floating exceptions raised (assuming ROP's are never passed to functions):
  537.  *    DIVIDE BY ZERO - (div)
  538.  *    OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
  539.  *
  540.  * floor raises integer overflow if the float is out of 32-bit range,
  541.  * so the float is tested before conversion, to make sure it is in (31-bit)
  542.  * range */
  543. .set noreorder
  544. maxint:    .double    1073741824.0
  545. .set reorder
  546. ML_CODE_HDR(floor_a)
  547.     lwc1    $f4,LITTLEPART($stdarg)    /* get least significant word */
  548.     lwc1    $f5,BIGPART($stdarg)    /* get most significant word */
  549.     mtc1    $zero,$f2            /* ($f2,$f3) := maxint */
  550.      lui    $atmp3,0x41d0
  551.     mtc1    $atmp3,$f3
  552.     abs.d    $f6,$f4
  553.     c.le.d    $f6,$f2
  554.     cfc1    $atmp3,$31            /* grab fpa control register */
  555.     bc1f    over
  556.     ori    $atmp2,$atmp3,0x03        /* set rounding bits to 11 */
  557.     ctc1    $atmp2,$31            /* return fpa control register */
  558.     cvt.w.d $f6,$f4            /* convert to integer */
  559.     ctc1    $atmp3,$31            /* return fpa control register */
  560.     mfc1    $stdarg,$f6        /* get in std argument register */
  561.     add    $stdarg,$stdarg        /* make room for tag bit */
  562.     add    $stdarg,1        /* add the tag bit */
  563.     CONTINUE
  564.  
  565.  
  566. ML_CODE_HDR(logb_a)
  567.     lw     $stdarg,BIGPART($stdarg)/* most significant part */
  568.     srl     $stdarg,20        /* throw out 20 low bits */
  569.     andi    $stdarg,0x07ff        /* clear all but 11 low bits */
  570.     sub     $stdarg,1023        /* subtract 1023 */
  571.     sll     $stdarg,1        /* make room for tag bit */
  572.     add    $stdarg,1        /* add the tag bit */
  573.     CONTINUE
  574.  
  575. ML_CODE_HDR(scalb_a)
  576.     CHECKLIMIT(closmask)
  577.     lw     $atmp1,4($stdarg)    /* get tagged n */
  578.     sra    $atmp1,1        /* get real n */
  579.     beqz    $atmp1,9f        /* if zero, return the old float */
  580.     lw    $ptrtmp,0($stdarg)    /* get pointer to float */
  581.     lw     $atmp2,BIGPART($ptrtmp)    /* most significant part */
  582.     srl     $atmp2,20        /* throw out 20 low bits */
  583.     andi    $atmp2,0x07ff        /* clear all but 11 low bits */
  584.     add    $atmp3,$atmp2,$atmp1    /* new := old + n */
  585.     blt    $atmp3,1,under        /* punt if underflow */
  586.     bgt    $atmp3,2046,over    /* or overflow */
  587.     xor    $atmp3,$atmp2        /* at3 = new xor old */
  588.     sll    $atmp3,20        /* put exponent in right position */
  589.     lw    $atmp2,BIGPART($ptrtmp)    /* most significant word */
  590.     xor    $atmp2,$atmp3        /* change to new exponent */
  591.     sw    $atmp2,BIGPART+4($allocptr)    /* save */
  592.     lw     $atmp2,LITTLEPART($ptrtmp) /* get least significant word */
  593.     sw    $atmp2,LITTLEPART+4($allocptr)    /* save lsw */
  594. 8:    li    $atmp4,DESC_reald        /* make descriptor */
  595.     sw    $atmp4,0($allocptr)    /* save descriptor */
  596.     add    $stdarg,$allocptr,4    /* get pointer to new float */
  597.     add    $allocptr,12        /* point to new free word */
  598.         CONTINUE
  599.  
  600. 9:    lw    $stdarg,0($stdarg)    /* get old float */
  601.     CONTINUE
  602.  
  603. over:    li    $atmp3,0x7fffffff
  604.     add    $atmp3,$atmp3        /* generate overflow exception */
  605.  
  606. under:    sw    $zero,4($allocptr)        /* return 0.0 */
  607.     sw    $zero,8($allocptr)
  608.     b    8b
  609.  
  610. /* set_fsr:
  611.  * Turn on floating-point overflow, underflow and zero-divide exceptions.
  612.  */
  613.     .globl    set_fsr
  614.     .ent    set_fsr
  615. set_fsr:
  616.     cfc1    $atmp1,$31        /* grab fpa control register */
  617.     ori     $atmp1,$atmp1,0xe00    /* set V, O, and Z bits */
  618.     ctc1    $atmp1,$31        /* return fpa control register */
  619.     j    $31
  620.     .end    set_fsr
  621.  
  622. /* this bogosity is for export.c */
  623.     .globl    startptr
  624. startptr: .word    __start
  625.